home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / LWP / Debug.pm next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.0 KB  |  120 lines
  1. package LWP::Debug;
  2.  
  3. =head1 NAME
  4.  
  5. LWP::Debug - debug routines for the libwww-perl library
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.  use LWP::Debug qw(+ -conns);
  10.  
  11.  LWP::Debug::trace('send()');
  12.  LWP::Debug::debug('url ok');
  13.  LWP::Debug::conns("read $n bytes: $data");
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. LWP::Debug provides tracing facilities. The trace(), debug() and
  18. conns() function are called within the library and they log
  19. information at increasing levels of detail. Which level of detail is
  20. actually printed is controlled with the C<level()> function.
  21.  
  22. =head1 FUNCTIONS
  23.  
  24. =head2 level(...)
  25.  
  26. The C<level()> function controls the level of detail being
  27. logged. Passing '+' or '-' indicates full and no logging
  28. respectively. Inidividual levels can switched on and of by passing the
  29. name of the level with a '+' or '-' prepended.  The levels are:
  30.  
  31.   trace   : trace function calls
  32.   debug   : print debug messages
  33.   conns   : show all data transfered over the connections
  34.  
  35. The LWP::Debug module provide a special import() method that allows
  36. you to pass the level() arguments with initial use statement.  If a
  37. use argument start with '+' or '-' then it is passed to the level
  38. function, else the name is exported as usual.  The following two
  39. statements are thus equivalent (if you ignore that the second pollutes
  40. your namespace):
  41.  
  42.   use LWP::Debug qw(+);
  43.   use LWP::Debug qw(level); level('+');
  44.  
  45. =head2 trace($msg)
  46.  
  47. The C<trace()> function is used for tracing function
  48. calls. The package and calling subroutine name is
  49. printed along with the passed argument. This should
  50. be called at the start of every major function.
  51.  
  52. =head2 debug($msg)
  53.  
  54. The C<debug()> function is used for high-granularity
  55. reporting of state in functions.
  56.  
  57. =head2 conns($msg)
  58.  
  59. The C<conns()> function is used to show data being
  60. transferred over the connections. This may generate
  61. considerable output.
  62.  
  63. =cut
  64.  
  65. require Exporter;
  66. @ISA = qw(Exporter);
  67. @EXPORT_OK = qw(level trace debug conns);
  68.  
  69. use Carp ();
  70.  
  71. my @levels = qw(trace debug conns);
  72. %current_level = ();
  73.  
  74. sub import
  75. {
  76.     my $pack = shift;
  77.     my $callpkg = caller(0);
  78.     my @symbols = ();
  79.     my @levels = ();
  80.     for (@_) {
  81.     if (/^[-+]/) {
  82.         push(@levels, $_);
  83.     } else {
  84.         push(@symbols, $_);
  85.     }
  86.     }
  87.     Exporter::export($pack, $callpkg, @symbols);
  88.     level(@levels);
  89. }
  90.  
  91. sub level
  92. {
  93.     for (@_) {
  94.     if ($_ eq '+') {              # all on
  95.         %current_level = map { $_ => 1 } @levels;
  96.     } elsif ($_ eq '-') {           # all off
  97.         %current_level = ();
  98.     } elsif (/^([-+])(\w+)$/) {
  99.         $current_level{$2} = $1 eq '+';
  100.     } else {
  101.         Carp::croak("Illegal level format $_");
  102.     }
  103.     }
  104. }
  105.  
  106. sub trace  { _log(@_) if $current_level{'trace'}; }
  107. sub debug  { _log(@_) if $current_level{'debug'}; }
  108. sub conns  { _log(@_) if $current_level{'conns'}; }
  109.  
  110. sub _log
  111. {
  112.     my $msg = shift;
  113.     $msg .= "\n" unless $msg =~ /\n$/;  # ensure trailing "\n"
  114.  
  115.     my($package,$filename,$line,$sub) = caller(2);
  116.     print STDERR "$sub: $msg";
  117. }
  118.  
  119. 1;
  120.